unit F_Funciones;

interface

uses
  Windows, SysUtils, IniFiles, Dialogs, Classes, Forms, Controls, WinSpool;
type
  PPdfObj = ^TPdfObj;
  TPdfObj = record
    number,
    offset: integer;
  end;

  function CtrlDown : Boolean;
  function ShiftDown : Boolean;
  function F1Down : Boolean;
  function F6Down : Boolean;

  function ExtractRutaConfiguracion:string;
  function RegisterAsService(Active: boolean): boolean;

  function getPassword(Letras, Num: integer): string;

  procedure EliminarArchivo(Archivo:String);
  procedure EliminaCarpeta(Carpeta:String);
  function ReadIniFile(Seccion,Identificador,Default: String):String;
  function ReadIniBoolFile(Seccion,Identificador: String; Default: Boolean):Boolean;
  function ContarArvhivosEnCarpeta(Carpeta:String):integer;
  procedure ChangeDefaultPrinter(const Name: string) ;
  function ValidateDocument(Documento:String):string;

  function GetPdfPageCount(const filename: string): integer;

  function IntToMounth(const mounth: integer): string;

implementation

function ExtractRutaConfiguracion:string;
begin
  Result:= ExtractFileDir (paramstr(0))+'\config.ini';
end;

function getPassword(Letras, Num: integer): string;
    const
     Consonantes = 'BCDFGHJKLMNPQRSTVWXYZ';
     Vocales = 'AEIOU';
     Numeros = '0123456789';
   var
     Longitud, n:integer;
   begin
     Longitud:= Letras + Num;
     Randomize;
     Result:='';
     for n:=1 to Trunc ((Longitud/2)*(Letras/Longitud)) do
        begin
          Result:=Result+Consonantes[1+Random(Length(Consonantes))];
          Result:=Result+Vocales[1+Random(Length(Vocales))];
        end;
     for n:=1 to Trunc ((Longitud)*(Num/Longitud)) do
        begin
          Result:=Result+Numeros[1+Random(Length(Numeros))];
        end;
     getPassword:=Result;
end;


function ReadIniFile(Seccion,Identificador,Default: String):String;
var
  MiFichero : TIniFile;
  ruta:string;
begin
  ruta:= ExtractFileDir (paramstr(0))+'\config.ini';
  try
    MiFichero:=TIniFile.Create(ruta);
    Result:= MiFIchero.ReadString(Seccion,Identificador,Default);

  finally
    MiFIchero.Free;
  end;
end;

function ReadIniBoolFile(Seccion,Identificador: String; Default: Boolean):Boolean;
var
  MiFichero : TIniFile;
  ruta:string;
begin
  ruta:= ExtractFileDir (paramstr(0))+'\config.ini';
  try
    MiFichero:=TIniFile.Create(ruta);
    Result:= MiFIchero.ReadBool(Seccion,Identificador,Default);
  finally
    MiFIchero.Free;
  end;
end;

procedure EliminarArchivo(Archivo:String);
begin
  if FileExists(Archivo) then
    DeleteFile(Archivo);
end;

procedure EliminaCarpeta(Carpeta:String);
var 
I: Integer;
DirInfo: tSearchRec;
begin
  I := FindFirst(Carpeta+'*.ffdp', faAnyFile, DirInfo);
  while I = 0 do
  begin
    DeleteFile(pChar(Carpeta+DirInfo.Name));
    I := FindNext(DirInfo);
  end;
  FindClose(DirInfo);
  //RemoveDir(Carpeta);
end;

function ContarArvhivosEnCarpeta(Carpeta:String):integer;
var
I, Aux: Integer;
DirInfo: tSearchRec;
begin
  Aux:= 0;
  I := FindFirst(Carpeta+'*.ffdp', faAnyFile, DirInfo);
  while I = 0 do
  begin
    Aux:= Aux+1;
    I := FindNext(DirInfo);
  end;
  FindClose(DirInfo);
  Result:= Aux;
end;

function GetPdfPageCount(const filename: string): integer;
var
  ms: TMemoryStream;
  k, cnt, pagesNum, rootNum: integer;
  p, p2: pchar;
  PdfObj: PPdfObj;
  PdfObjList: TList;

  //Summary of steps taken to parse PDF file for page count :-
  //1. Locate 'startxref' at end of file
  //2. get 'xref' offset and go to xref table
  //3. fill my pdfObj List with object numbers and offsets
  //4. handle subsections within xref table.
  //5. read 'trailer' section at end of each xref
  //6. store 'Root' object number if found in 'trailer'
  //7. if 'Prev' xref found in 'trailer' - loop back to step 2
  //8. locate Root in my full pdfObj List
  //9. locate 'Pages' object from Root
  //10. get Count from Pages.

  function GetNumber(out num: integer): boolean;
  var
    tmpStr: string;
  begin
    tmpStr := '';
    while p^ < #33 do inc(p); //skip leading CR,LF & SPC
    while (p^ in ['0'..'9']) do
    begin
      tmpStr := tmpStr + p^;
      inc(p);
    end;
    result := tmpStr <> '';
    if not result then exit;
    num := strtoint(tmpStr);
  end;

  function IsString(const str: string): boolean;
  var
    len: integer;
  begin
    len := length(str);
    result := CompareMem( p, pchar(str), len);
    inc(p, len);
  end;

  function FindStrInDict(const str: string): boolean;
  var
    nestLvl: integer;
    str1: char;
  begin
    //06-Mar-07: bugfix- added nested dictionary support
    //nb: PDF 'dictionaries' start with '<<' and terminate with '>>'
    result := false;
    nestLvl := 0;
    str1 := str[1];
    while not result do
    begin
      while not (p^ in ['>','<',str1]) do inc(p);
      if (p^ = '<') then
      begin
        if (p+1)^ = '<' then begin inc(nestLvl); inc(p); end;
      end
      else if (p^ = '>') then
      begin
        if (p+1)^ = '>' then
        begin
          dec(nestLvl);
          inc(p);
          if nestLvl <= 0 then exit;
        end
      end else
      begin
        result := (nestLvl < 2) and IsString(str);
      end;
      inc(p);
    end;
  end;

begin
  //on error return -1 as page count
  result := -1;
  try
    ms := TMemoryStream.Create;
    PdfObjList := TList.Create;
    screen.Cursor := crHourGlass;
    application.ProcessMessages;
    try
      ms.LoadFromFile(filename);

      //find 'startxref' ignoring '%%EOF'
      p := pchar(ms.Memory) + ms.Size -5;
      //21-Jun-05: bugfix
      //sometimes rubbish is appended to the pdf so
      //look deeper for 'startxref'
      p2 := pchar(ms.Memory);
      repeat
        while (p > p2) and (p^ <> 'f') do dec(p);
        if (p = p2) then exit;
        if StrLComp( (p-8), 'startxref', 9) = 0 then break;
        dec(p);
      until false;
      inc(p);

      rootNum := -1; //ie flag not yet found

      //xref offset ==> k
      if not GetNumber(k) then exit;
      p :=  pchar(ms.Memory) + k +4;

      while true do //top of loop  //////////////////////////////
      begin
        //get base object number ==> k
        if not GetNumber(k) then exit;
        //get object count ==> cnt
        if not GetNumber(cnt) then exit;
        //07-Mar-07: bugfix
        //it is possible to have 0 objects in a section
        while p^ < #33 do inc(p); //skip CR, LF, SPC

        //add all objects in section to list ...
        for cnt := 0 to cnt-1 do
        begin
          new(PdfObj);
          PdfObjList.Add(PdfObj);
          PdfObj.number := k + cnt;
          if not GetNumber(PdfObj.offset) then exit;
          //14-Apr-07: workaround ... while each entry SHOULD be
          //exactly 20 bytes, not everyone seems to adhere to this.
          while not (p^ in [#10,#13]) do inc(p);
          while (p^ in [#10,#13]) do inc(p);
        end;
        //check for and process further subsections ...
        if p^ in ['0'..'9'] then continue;

        // parse 'trailer dictionary' ...
        if not IsString('trailer') then exit;
        p2 := p;
        // get Root (aka /Catalog) ...
        if (rootNum = -1) and FindStrInDict('/Root') then
          if not GetNumber(rootNum) then exit;
        p := p2;
        if not FindStrInDict('/Prev') then break; //no more xrefs

        //next xref offset ==> k
        if not GetNumber(k) then exit;
        p :=  pchar(ms.Memory) + k +4;

      end; //bottom of loop /////////////////////////////////////

      //Make sure we've got Root the object number ...
      if rootNum < 0 then exit;
      //Find Root object in list and go to its offset ...
      k := 0;
      while k < PdfObjList.Count do
        if PPdfObj(PdfObjList[k]).number = rootNum then
          break else
          inc(k);
      if k = PdfObjList.Count then exit;
      p := pchar(ms.Memory) + PPdfObj(PdfObjList[k]).offset;
      //double check that this is the Root object ...
      if not GetNumber(k) or (k <> rootNum) then exit;
      if not FindStrInDict('/Pages') then exit;
      //get Pages object number ==> pagesNum
      if not GetNumber(pagesNum) then exit;
      k := 0;
      while k < PdfObjList.Count do
        if PPdfObj(PdfObjList[k]).number = pagesNum then
          break else
          inc(k);
      if k = PdfObjList.Count then exit;
      //Pages object found in list, now go to offset ...
      p := pchar(ms.Memory) + PPdfObj(PdfObjList[k]).offset;
      //make sure it's the Pages object ...
      if not GetNumber(k) or (k <> pagesNum) then exit;
      if not FindStrInDict('/Count') then exit;
      if not GetNumber(cnt) then exit;
      //21-Jun-05: bugfix
      //occasionally the 'count' value is an indirect object
      if GetNumber(k) and IsString(' R') then
      begin
        //this is an indirect object to the count value,
        //so find the obj ...
        k := 0;
        while k < PdfObjList.Count do
          if PPdfObj(PdfObjList[k]).number = cnt then
            break else
            inc(k);
        if k = PdfObjList.Count then exit;
        p := pchar(ms.Memory) + PPdfObj(PdfObjList[k]).offset;
        if not GetNumber(k) or //skip the object num
          not GetNumber(k) or //skip the generation num
          not IsString(' obj') or
          not GetNumber(cnt) then exit;
      end;
      result := cnt;
    finally
      screen.Cursor := crDefault;
      for k := 0 to PdfObjList.Count -1 do
        dispose(PPdfObj(PdfObjList[k]));
      PdfObjList.Free;
      ms.Free;
    end;
  except
    //nb: errors are flagged by returning -1
  end;
end;

procedure ChangeDefaultPrinter(const Name: string) ;
var
    W2KSDP: function(pszPrinter: PChar): Boolean; stdcall;
    H: THandle;
    Size, Dummy: Cardinal;
    PI: PPrinterInfo2;
begin
    if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
    begin
      @W2KSDP := GetProcAddress(GetModuleHandle(winspl), 'SetDefaultPrinterA') ;
      if @W2KSDP = nil then RaiseLastOSError;
      if not W2KSDP(PChar(Name)) then RaiseLastOSError;
    end
    else
    begin
      if not OpenPrinter(PChar(Name), H, nil) then RaiseLastOSError;
      try
        GetPrinter(H, 2, nil, 0, @Size) ;
        if GetLastError <> ERROR_INSUFFICIENT_BUFFER then RaiseLastOSError;
        GetMem(PI, Size) ;
        try
          if not GetPrinter(H, 2, PI, Size, @Dummy) then RaiseLastOSError;
          PI^.Attributes := PI^.Attributes or PRINTER_ATTRIBUTE_DEFAULT;
          if not SetPrinter(H, 2, PI, PRINTER_CONTROL_SET_STATUS) then RaiseLastOSError;
        finally
          FreeMem(PI) ;
        end;
      finally
        ClosePrinter(H) ;
      end;
    end;
end; //ChangeDefaultPrinter

function ValidateDocument(Documento:String):string;
var
  s:string;
begin
  s:=StringReplace(Documento, '.', '', [rfReplaceAll]);
  s:=StringReplace(s, ' ', '', [rfReplaceAll]);
  Result:= s;
end;


function CtrlDown : Boolean;
var
   State : TKeyboardState;
begin
   GetKeyboardState(State) ;
   Result := ((State[vk_Control] And 128) <> 0) ;
end;

function ShiftDown : Boolean;
var
   State : TKeyboardState;
begin
   GetKeyboardState(State) ;
   Result := ((State[vk_Shift] and 128) <> 0) ;
end;

function F6Down : Boolean;
var
   State : TKeyboardState;
begin
   GetKeyboardState(State) ;
   Result := ((State[VK_F6] and 128) <> 0) ;
end;

function F1Down : Boolean;
var
   State : TKeyboardState;
begin
   GetKeyboardState(State) ;
   Result := ((State[VK_F1] and 128) <> 0) ;
end;

function IntToMounth(const mounth: integer): string;
var
  mes: string;
begin
  case (mounth) of
    1: mes := 'Enero';
    2: mes := 'Febrero';
    3: mes := 'Marzo';
    4: mes := 'Abril';
    5: mes := 'Mayo';
    6: mes := 'Junio';
    7: mes := 'Julio';
    8: mes := 'Agosto';
    9: mes := 'Septiembre';
    10: mes := 'Octubre';
    11: mes := 'Noviembre';
    12: mes := 'Diciembre';
  end;
  IntToMounth:= mes;
end;

  function RegisterAsService(Active: boolean): boolean;
  const
    RSP_SIMPLE_SERVICE = 1;
    RSP_UNREGISTER_SERVICE = 0;
  type
    TRegisterServiceProcessFunction =
      function (dwProcessID, dwType: Integer): Integer; stdcall;
  var
    module: HMODULE;
    RegServProc: TRegisterServiceProcessFunction;
  begin
    Result := False;
    module := LoadLibrary('KERNEL32.DLL');
    if module <> 0 then
      try
        RegServProc := GetProcAddress(module, 'RegisterServiceProcess');
        if Assigned(RegServProc) then
          if Active then
            Result := RegServProc(0, RSP_SIMPLE_SERVICE) = 1
          else
            Result := RegServProc(0, RSP_UNREGISTER_SERVICE) = 1;
      finally
        FreeLibrary(module);
      end;
  end;

end.
